home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / FILES.SWG / 0014_Set File Time (TOUCH).pas < prev    next >
Pascal/Delphi Source File  |  1993-05-29  |  2KB  |  67 lines
  1. (* FT.PAS *)
  2. (* Set file to a specific date *)
  3.  
  4. USES TPCrt, Dos, Misc, TimeDate;
  5. VAR
  6.   f : TEXT;
  7.   h, m, s, hund : WORD; { For GetTime}
  8.   ftime : LONGINT; { For Get/SetFTime}
  9.   dt : DateTime; { For Pack/UnpackTime}
  10.   DateS : DateStr;
  11.   FName : STRING;
  12.  
  13. PROCEDURE Syntax;
  14. BEGIN
  15.         ResetAttr (7);
  16.         CLRSCR;
  17.         GOTOXY (1, 24);
  18.         WRITELN ('FT.EXE    GDSOFT (c) 1992');
  19.         WRITELN ('Usage   : FT filename date', #07);
  20.         HALT (1);
  21. END;
  22.  
  23. FUNCTION UpperCase (InpStr : STRING) : STRING;
  24.  
  25. VAR i : INTEGER;
  26.  
  27. BEGIN
  28.    FOR i := 1 TO LENGTH (InpStr) DO
  29.        UpperCase [i] := UPCASE (InpStr [i]);
  30.    UpperCase [0] := InpStr [0]
  31. END;
  32.  
  33. FUNCTION LeadingZero (w : WORD) : STRING;
  34. VAR
  35.   s : STRING;
  36. BEGIN
  37.   STR (w : 0, s);
  38.   IF LENGTH (s) = 1 THEN
  39.     s := '0' + s;
  40.   LeadingZero := s;
  41. END;
  42.  
  43. BEGIN
  44.   ResetAttr (7);
  45.   CLRSCR;
  46.   IF (PARAMCOUNT < 1) OR NOT Exist (PARAMSTR (1) ) THEN Syntax;
  47.   FName := UpperCase (PARAMSTR (1) );
  48.   IF NOT ValidDate (PARAMSTR (2) ) THEN DateS := PlainDate ELSE DateS := PARAMSTR (2);
  49.   ASSIGN (f, FName);
  50.   RESET (f);
  51.   GETFTIME (f, ftime); { Get creation time }
  52.   UNPACKTIME (ftime, dt);
  53.   WRITELN ('File ', FName, ' created at ', LeadingZero (dt.hour),
  54.           ':', LeadingZero (dt.min), ':',
  55.           LeadingZero (dt.sec), ' on ', dt.Month, '/', dt.day, '/', dt.year);
  56.   WITH dt DO
  57.     BEGIN
  58.       FTime := PackDateTime (DateS, PlainTime);
  59.       WRITELN ('Setting file datestamp to ', MakeSlashDate (DateS) );
  60.       SETFTIME (f, ftime);
  61.     END;
  62.   CLOSE (f);   { Close file }
  63. END.
  64.  
  65.  
  66.  
  67.